Celestin Apprentice 4/Apprentice-Release4.iso/Languages/RLaB 1.18c/misc/gnu_plot.r

Text File | 1994-10-22 | 8.2 KB | 417 lines | [TEXT/ttxt]

//-------------------------------------------------------------------//

//  Syntax:    plot ( A , I )
//        pclose ( I )
//        phrd ( I )
//        setterm ( TERM , I )
//        showplot ( I )

//  Description:

//  The plot function plots numeric data via the GNUPLOT program. The
//  argument A can be a matrix, or a list of matrices, or a string.
//  When A is a matrix, columns 2 through N are plotted versus the 1st
//  column. When A is a list of matrices, each matrix is plotted
//  versus it's own 1st column. When A is a string, the string is sent
//  to GNUPLOT as a command.

//    plot ( M )        // plots the contents of matrix M
//    plot ( << M1; M2>> )    // plots M1, and M2 on the same graph
//    plot ("replot")        // sends the string directly to
//                // GNUPLOT as a command

//  Using a list of matrices as an argument to plot is useful when the
//  the independent variable (1st column) of each matrix is different.

//  The second, and optional argument to plot denotes the plot process
//  number. The plot function will open distinct plot processes when
//  given distinct values of N. When this feature is used in a
//  X-windows environment, the effect is to create separate plot
//  windows. For example:

//      plot (M);        // plot the contents if matrix M
//      plot (2.*M, 1);        // plot 2 times M, to another window

//  The pclose function closes (destroys)  the I-th GNUPLOT
//  subprocess.

//  The phrd function generates a PostScript file of the current I-th
//  plot. The PostScript plot is save in a file for printing, or
//  whatever. Immediately after calling phrd(), the GNUPLOT variables
//  term, and output are reset to there former values.

//  The setterm function allows the user to set/reset the I-th plot's
//  term type. The argument TERM is a string that corresponds to one
//  of GNUPLOT's available term types, for example "vttek".

//  The showplot function prints the contents of the I-th plot list to
//  stdout.

//  The plot function is an interface to the GNUPLOT program. The plot
//  function uses temporary files and Rlab's piping capability to
//  transparently plot numerical data via GNUPLOT. Since the plot
//  function is an rfile, it could easily be modified to to use
//  another plotting program.

//-------------------------------------------------------------------//


//
// List to contain plot-object lists.
//

static (p);
p = <<>>;

//
// Internal plot-related functions
//

static (plotl, plotm, plots);
static (pobj_Create, pobj_Reset, pobj_Destroy);
static (pobj_TmpFileName, pobj_WriteData, pobj_PlotCmd);
static (pobj_Plot, pobj_SetRm, pobj_Rm);

//
// User interface to plot functionality
//

plot = function ( data , N )
{
  if (!exist (N)) { N = 0; }    // Always the default plot-object

  // Check the existence of p.[N]
  if (max (size (N)) != 1) { error ("plot(): N must be a 1-by-1"); }
  if (exist (p.[N]))
  {
    pobj_Reset (N);
  else
    pobj_Create (N);
  }

  if (class (data) == "num")
  {
    pobj_Rm (N);
    plotm (data, N, 1);
    pobj_Plot (N);
    pobj_SetRm (N);
  else if (class (data) == "string") {
    plots (data, N);
    pobj_Plot (N);
  else if (class (data) == "list") {
    pobj_Rm (N);
    plotl (data, N);
    pobj_Plot (N);
    pobj_SetRm (N);
  else
    error ("Invalid data for plot()");
  }}}

};

pclose = function ( N )
{
  if (!exist (N)) { N = 0; }
  if (!exist (p.[N])) { return -1; }
  close (p.[N].rmf);
  close (p.[N].prog);
  pobj_Destroy (N);
  return N;
};

phrd = function ( N )
{
  if (!exist (N)) { N = 0; }
  if (!exist (p.[N]))
  {
    error ("No existing plot to make hardcopy from");
  }

  //
  // Make hardcopy file
  //

  fprintf (p.[N].prog, "set term %s\n", p.[N].hrd);
  fprintf (p.[N].prog, "set output \"%s\"\n", p.[N].hrdf);
  fprintf (p.[N].prog, "replot\n");

  //
  // Reset to original term type, and replot
  //

  fprintf (p.[N].prog, "set term %s\n", p.[N].term);
  fprintf (p.[N].prog, "set output \"%s\"\n", p.[N].output);
  fprintf (p.[N].prog, "replot\n");
};

//
// Set the terminal type for the I-th GNUPLOT process
//

setterm = function ( TERM, N )
{
  if (!exist (N)) { N = 0; }
  if (!exist (p.[N]))
  {
    pobj_Create (N);
  }
  p.[N].term = TERM;

  //
  // Now send the "set term" command to GNUPLOT
  //

  fprintf (p.[N].prog, "set term %s\n", TERM);
};

//
// Print out the plot list
//

showplot = function ( N )
{
  if (!exist (N)) { N = 0; }
  if (!exist (p.[N]))
  {
    pobj_Create (N);
  }

  printf ("\tPlot List %i\n", N);
  printf ("\t\tTerm:\t\t\t%s\n", p.[N].term);
  printf ("\t\tOutput:\t\t\t%s\n", p.[N].output);
  printf ("\t\tTmp Files:\t\t%s\n", p.[N].files);
  printf ("\t\tHardCopy:\t\t%s\n", p.[N].hrd);
  printf ("\t\tHardCopy Files:\t\t%s\n", p.[N].hrdf);
};

//====================
// Static Functions  =
//====================

plotl = function ( data, N )
{
  local (I, i);
  I = 1;
  for (i in members (data))
  {
    if (class (data.[i]) == "num")
    {
      plotm (data.[i], N, I);
      I++;
    }
  }
};

//
// Set-Up to plot a matrix. Columns 2...N against 1st column.
//

plotm = function ( data , N, I )
{
  local (ans, fn, i, nplot);

  // Determine how many lines to draw
  nplot = max ([1, data.nc - 1]);

  if (nplot > data.nr)
  {
    printf (" Plot %i columns, are you sure (y/n) ? ", data.nc);
    ans = getline ("stdin");
    if (ans.[1] != "y")
    {
      return 0;
    }
  }

  // Generate two column matrices for plot program
  for (i in 1:nplot)
  {
    // Create tmp-file-name
    fn = pobj_TmpFileName (N, i, I);

    // Write data to tmp-file
    // Add to plot command
    if (nplot == 1)
    {
      pobj_WriteData (real (data), fn);
      pobj_PlotCmd (N, i, "C", fn);
    else
      pobj_WriteData (real (data[;1,i+1]), fn);
      pobj_PlotCmd (N, i, "C", fn);
    }
  }
};

//
// Form a plain string to send to GNUPLOT as
// command
//

plots = function ( data , N )
{
  // Send the string to GNUPLOT

  p.[N].pcmd = data + "\n";
};

//
// Create a plot-object.
//

pobj_Create = function ( N )
{
  local (plist);

  plist.files = "";        // The tmp files to plot
  plist.pcmd = "";        // Where the plot command will go

  //
  // Init string for plotting program
  //

  plist.init = "set grid\nset data style lines\n";

  //
  // The program that draws the plot(s)
  //

  sprintf (plist.prog, "|gnuplot #%i", N);

  //
  // To remove tmp-files
  //

  sprintf (plist.rmf, "|rm -f `cat` #%i", N);

  //
  // Keep track of terminal type, and output
  //

  plist.term = "X11";
  plist.output = "stdout";

  //
  // To generate hardcopy
  //

  plist.hrd = "postscript";
  sprintf (plist.hrdf, "rlab-tmp-hrdf.%i", N);

  //
  // Copy the local list into the static plot-object collection
  //

  p.[N] = plist;
  fprintf (p.[N].prog, "%s", p.[N].init);
  fprintf (p.[N].prog, "set term %s\n", p.[N].term);
};

//
// Reset a plot object to plot new data
//

pobj_Reset = function ( N )
{
  //
  // Close any existing tmp-files that belong
  // to plot-object N. Reset the file-name list.
  //

  p.[N].files = "";
  p.[N].pcmd = "";
};

//
// Destroy a plot-object
//

pobj_Destroy = function ( N )
{
  if (exist (p.[N]))
  {
    clear (p.[N]);
  }
};

//
// Create a tmp-file name
//

pobj_TmpFileName = function ( N, i, j )
{
  local (tmp);
  sprintf (tmp, "rlab-tmpf-%i-%i-%i", N, i, j);
  p.[N].files = p.[N].files + " " + tmp;
  return tmp;
};

//
// Add data-file (tmp-file) to plot object list of stuff
// to be plotted.
//

pobj_WriteData = function ( m, file )
{
  write (file, m);
  close (file);
};

//
// Create the command(s) to plot all the data in the plot object.
//

pobj_PlotCmd = function ( N, i, nm, fn )
{
  local (tmp);

  if(p.[N].pcmd == "")
  {
    sprintf(tmp, "plot '%s' title '%s-%i'", fn, nm, i+1);
  else
    sprintf(tmp,    ", '%s' title '%s-%i'", fn, nm, i+1);
  }

  p.[N].pcmd = p.[N].pcmd + tmp;
};

//
// Force the plot program to create the plot
//

pobj_Plot = function ( N )
{
  //  fprintf ("stdout", "%s\n", p.[N].pcmd);
  fprintf (p.[N].prog, "%s\n", p.[N].pcmd);
};

//
// Setup so the tmp-files can be removed
//

pobj_SetRm = function ( N )
{
  fprintf(p.[N].rmf, "%s", p.[N].files);
};

//
// Remove the tmp-files
//

pobj_Rm = function ( N )
{
  if (length (p.[N].files) != 0)
  {
    close (p.[N].rmf);
  }
};

//
// Provide access to the plot-list
//

_pobj_list = function ( N )
{
  if (!exist (N)) { N = 0; }
  return p.[N];
};